perm filename MISNEW.SAI[SYS,HE] blob
sn#004288 filedate 1972-10-31 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00015 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00005 00002 BEGIN "MISC"
00008 00003 ⊃ DISPLAY LINE BEING FIT
00010 00004 ⊃ ROUTINE TO CLEAN UP LINES FOR FUTURE PROCESSING
00013 00005 ⊃ NOW ATTEMPT TO EXTEND DANGLING ENDPOINTS [¬JOIN] TO SOME CORNER
00018 00006 ⊃ 3. IF INTERSECTED LINE LESS THAN COORDMAX FROM END POINT,
00021 00007 ⊃ MERGE ALL ENDPOINTS WITHIN COORDMAX OF EACH OTHER AND DELETE EXTRA LINES
00026 00008 ⊃ REMOVE ALL LINES NOT PART OF CLOSED OUTLINE
00028 00009 ⊃ GENERATE TABLE OF VERTICIES
00030 00010 ⊃ GENERATE DATA STRUCTURE
00033 00011 ⊃ OUTPUT DATA STRUCTURE FOR COMPLEX (CURRENTLY ONLY TO DISK FILE SPECIFIED BY USER)
00036 00012 ⊃ DELETE LOCAL MODEL
00038 00013 ⊃ PROCESS FITTED OUTLINE
00042 00014 ⊃ COMPUTE 'ANGLE' FOR CLOSED CURVE ROUTINE
00044 00015 ⊃ MAIN PROGRAM
00046 ENDMK
⊗;
BEGIN "MISC"
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
REQUIRE "SQRT[SYS,HE]" LOAD_MODULE;
REQUIRE 500 STRING_SPACE;
REQUIRE 200 NEW_ITEMS;
EXTERNAL INTEGER PROCEDURE CUR1(REAL ARRAY D,ODAT;REFERENCE INTEGER SCNT,SMAX);
EXTERNAL PROCEDURE CUROFF;
EXTERNAL REAL PROCEDURE SQRT(REAL X);
EXTERNAL PROCEDURE CURVON;
EXTERNAL PROCEDURE ARROW_DPY(REAL X,Y);
EXTERNAL PROCEDURE FADCHG(REAL X,Y;PROCEDURE PROC);
EXTERNAL PROCEDURE FRDCHG(REAL X,Y;PROCEDURE PROC);
EXTERNAL PROCEDURE FNDINT(REFERENCE REAL LINE; REFERENCE INTEGER I,JOIN,A; INTEGER C);
EXTERNAL BOOLEAN PROCEDURE FND;
EXTERNAL PROCEDURE FIX(INTEGER DC;REFERENCE INTEGER J; REFERENCE REAL D,L);
EXTERNAL PROCEDURE DUP(REFERENCE REAL L; REFERENCE INTEGER C);
EXTERNAL PROCEDURE MERGE(REFERENCE INTEGER I,E,INDEX;REAL X1,Y1;REFERENCE REAL X2,Y2,LINE;INTEGER C);
EXTERNAL INTEGER PROCEDURE GET(REAL X,Y);
EXTERNAL PROCEDURE GETINT(REFERENCE REAL V; REFERENCE INTEGER MX);
EXTERNAL PROCEDURE REGINT(INTEGER C,B; REAL X,Y; REFERENCE INTEGER I,J,COUNT;REFERENCE REAL LINE);
EXTERNAL BOOLEAN PROCEDURE REGGET;
INTEGER J,I,EOF,BRK, DISSIZ;
INTERNAL INTEGER FRAMEY;
STRING INP;
INTEGER ITEMVAR NEWBLOB;
EXTERNAL BOOLEAN DD_DISP, XDEB, DISCUR, XDMP;
EXTERNAL INTEGER FRAMEX;
REAL ARRAY ITEMVAR EXTLINE;
SAFE INTEGER ARRAY DISPL[1:300];
DEFINE CRLF="'15&'12",SAFEX="", SMAX="200", ⊃="COMMENT",COORDIF="15.0",
COORDMAX="4.0",PARA=".4",
DPYSETUP="IF DD_DISP THEN RELPOG(FRAMEX);
IF FRAMEX<0 THEN FRAMEX ← GETPOG;
DPYSET(DISPL);
DPYBRT(7)";
BOOLEAN STAT_CURV;
FORWARD SIMPLE REAL PROCEDURE ANG(REAL DX,DY);
⊃ DISPLAY LINE BEING FIT;
INTERNAL PROCEDURE DISP(SAFEX REAL ARRAY D);
BEGIN INTEGER X, Y, CNT, PNT, I, J;
SAFEX INTEGER ARRAY DISPL[1:DISSIZ];
IF FRAMEY<0 THEN FRAMEY ← GETPOG;
DPYSET(DISPL);
DPYBRT(1);
FADCHG(0,0,AIVECT);
J ← 1;
DO BEGIN
CNT ← ABS(D[J,1]);
PNT ← D[J,2];
FOR I ← 1 STEP 1 UNTIL CNT DO FRDCHG(D[J+I,1],D[J+I,2],RPOINT);
J ← PNT;
END UNTIL ¬J;
DPYOUT(FRAMEY);
END;
⊃ PRINT CURRENT SET OF LINES;
SIMPLE PROCEDURE DUMPLINE(STRING FOO; REAL ARRAY LINE; BOOLEAN ARRAY JOIN; INTEGER C);
BEGIN "D1" INTEGER I;
OUT(3,FOO&CRLF);
FOR I←1 STEP 1 UNTIL C DO
OUT(3,CVS(I)&CVF(LINE[I,1])&CVF(LINE[I,2])&(IF JOIN[I,1] THEN "*" ELSE " ")&
CVF(LINE[I,3])&CVF(LINE[I,4])&(IF JOIN[I,2] THEN "*" ELSE " ")&CRLF);
OUT(3,CRLF);
END "D1";
⊃ ROUTINE TO CLEAN UP LINES FOR FUTURE PROCESSING;
PROCEDURE FIXUP(REAL ARRAY D; REFERENCE INTEGER S;INTEGER CNT,TESTX);
BEGIN SAFEX REAL ARRAY LINE[1:CNT*2,1:4];
SAFEX INTEGER ARRAY JOIN[1:CNT*2,1:2], INDEX[1:CNT,1:2];
INTEGER DCNT, I, IND, C, J, K, A, B, F, G, E, IDELT, JDELT;
REAL TEST, DD, X, Y, X1, Y1, X2, Y2, X3, Y3, XX, YY, A1, B1, C1, A2,
B2, C2, GX, GY, E1, E2, TST, LDIST, EDIST;
LABEL L1, L2, L3, L4, L5, L6, L7, L8, JMP1;
DEFINE HANG(I)="JOIN[I,1]", OUTER(I)="JOIN[I,2]";
⊃ FILL LINE ARRAY AND SET JOIN ARRAY IF TWO LINES HAVE COMMON CORNER;
IF DISCUR THEN BEGIN OUTSTR("DEBUG FIXUP?");XDEB←INCHWL="Y"; END;
C ← 0;
IND ←1;
DO IF (DCNT←D[IND,1])>0 THEN
BEGIN "OUT"
FOR I←1 STEP 1 UNTIL DCNT-1 DO
BEGIN
J ← C+I;
K ← IND+I;
FOR A←1,2 DO BEGIN LINE[J,A]←D[K,A];LINE[J,A+2]←D[K+1,A];END;
JOIN[J,1] ← JOIN[J,2] ← 1;
END;
C ← C+DCNT;
K ← IND+DCNT;
FOR A←1,2 DO BEGIN LINE[C,A]←D[K,A];LINE[C,A+2]←D[IND+1,A];END;
JOIN[C,1] ← JOIN[C,2] ← 1;
DONE;
END "OUT" UNTIL (IND←IND+ABS(DCNT)+1)≥S;
IND ←1;
DO BEGIN
DCNT ← ABS(D[IND,1]);
IF D[IND,1]<0 THEN
BEGIN "IN"
FIX(DCNT-1,JOIN[C+1,1],D[IND+1,1],LINE[C+1,1]);
C ← C+DCNT-1;
END "IN";
IND ←IND+DCNT+1;
END UNTIL IND≥S;
S ← 1;
IF TESTX THEN GO TO JMP1;
⊃ NOW ATTEMPT TO EXTEND DANGLING ENDPOINTS [¬JOIN] TO SOME CORNER;
⊃ 1. FIND A DANGLING ENDPOINT;
SETFORMAT(10,3);
IF XDMP THEN DUMPLINE("BEFORE FIXUP",LINE,JOIN,C);
FOR I← 1 STEP 1 UNTIL C DO
BEGIN "DANGLE" REAL FOO;
IF ¬JOIN[I,1] THEN E←1 ELSE
L2: IF ¬JOIN[I,2] THEN E←3 ELSE GO TO L1;
X ← LINE[I,E];
Y ← LINE[I,E+1];
K ← IF E=1 THEN 3 ELSE 1;
X1 ← LINE[I,K];
Y1 ← LINE[I,K+1];
EDIST ← LDIST ← 1000.0;
FOO ← SQRT((X-X1)↑2+(Y-Y1)↑2);
FOO ← (FOO-COORDMAX) MAX (FOO/2.0);
⊃ 2. NOW I IS A DANGLING LINE AND E POINTS TO THE END POINT.
X,Y ARE COORDINATES OF THE DANGLING END
X1,Y1 ARE COORDINATES OF THE OTHER END.
FOO IS THE LENGTH OF THE LINE
INTERSECT THE LINE WITH ALL OTHER LINES. SAVE CLOSEST
LINE (<COORDIF*2) WITH INTERSECTION ON LINE OR WITHIN
COORDIF OF IT IF BOTH LINES DANGLING;
FOR J←1 STEP 1 UNTIL C DO IF I≠J THEN
BEGIN "MATCH" LABEL L4,L1;
XX ← LINE[J,1];
YY ← LINE[J,2];
X2 ← LINE[J,3];
Y2 ← LINE[J,4];
IF (XX=X1∧YY=Y1)∨(X2=X1∧Y2=Y1) THEN GO TO L4;
A1 ← YY-Y2;
B1 ← X2-XX;
C1 ← X2*A1+Y2*B1;
A2 ← Y1-Y;
B2 ← X-X1;
C2 ← X*A2+Y*B2;
DD ← A1*B2-A2*B1;
IF ABS(DD)<0.01 THEN GO TO L4;
X3 ← (C1*B2-C2*B1)/DD;
Y3 ← (A1*C2-A2*C1)/DD;
E1 ← SQRT((X3-X)↑2+(Y3-Y)↑2);
IF XDEB THEN
BEGIN "D1"
INTEGER I;
DPYSETUP;
FADCHG(0,0,AIVECT);
FOR I←1 STEP 1 UNTIL C DO
BEGIN
FRDCHG(LINE[I,1],LINE[I,2],RIVECT);
FRDCHG(LINE[I,3],LINE[I,4],RVECT);
END;
ARROW_DPY(X,Y);
ARROW_DPY(X3,Y3);
FADCHG(50.0,260.0,AIVECT);
DPYSST("LDIST="&CVF(E1));
END "D1";
IF E1>COORDIF*2.0 THEN GO TO L4;
E2 ← SQRT((X3-XX)↑2+(Y3-YY)↑2);
TST ← SQRT((X3-X2)↑2+(Y3-Y2)↑2);
IF E2<TST THEN B←1 ELSE BEGIN B←3; E2←TST; END;
IF XDEB THEN
BEGIN "D2"
DPYSST(" EDIST="&CVF(E2));
ARROW_DPY(LINE[J,B],LINE[J,B+1]);
END "D2";
DCNT ← JOIN[J,(B DIV 2)+1];
IF SQRT((X3-X1)↑2+(Y3-Y1)↑2)<FOO THEN GO TO L1;
IF (F←(¬((XX MIN X2)≤X3≤(XX MAX X2)∧(YY MIN Y2)≤Y3≤(YY MAX Y2))))∧
((DCNT∧E2>COORDMAX)∨(E2>COORDIF)) THEN GO TO L1;
IF F THEN BEGIN IF E1*E2>LDIST*EDIST∨E1>LDIST*2.0 THEN GO TO L1 END ELSE
IF E1>LDIST THEN GO TO L1;
LDIST ← E1;
EDIST ← IF F THEN -E2 ELSE E2;
IDELT ← J;
JDELT ← B;
GX ← X3;
GY ← Y3;
L1: IF XDEB THEN
BEGIN
DPYSST(" ACDIST="&CVF(LDIST));
DPYOUT(FRAMEX);
INCHWL;
END;
L4: END "MATCH";
IF LDIST≥1000.0 THEN
BEGIN
IF XDMP THEN OUT(3,"FAILED"&CVS(I)&CVS(E)&CRLF);
GO TO L3;
END;
⊃ 3. IF INTERSECTED LINE LESS THAN COORDMAX FROM END POINT,
MOVE DANGLING LINE TO CORNER.
OTHERWISE, USE INTERSECTION AND TEST FOR PARALLEL;
J ← (JDELT DIV 2)+1;
K ← (E DIV 2) +1;
IF ABS(EDIST)<COORDMAX∧JOIN[IDELT,J] THEN
BEGIN "MOVE"
LINE[I,E] ← LINE[IDELT,JDELT];
LINE[I,E+1] ← LINE[IDELT,JDELT+1];
JOIN[I,K] ← 1;
IF XDMP THEN OUT(3,CRLF&"MOVED"&CVS(I)&CVS(E)&" TO"&CVS(IDELT)&CVS(JDELT)&CRLF);
END "MOVE" ELSE IF EDIST<0 THEN BEGIN "JOIN"
A ← IF E=1 THEN 3 ELSE 1;
B ← IF JDELT=1 THEN 3 ELSE 1;
IF ABS((LINE[I,A+1]-GY)*(GX-LINE[IDELT,A])-(LINE[I,A]-GX)*(GY-LINE[IDELT,B+1]))>PARA THEN
BEGIN "NOP"
LINE[I,E] ← LINE[IDELT,JDELT] ← GX;
LINE[I,E+1] ← LINE[IDELT,JDELT+1] ← GY;
JOIN[I,K] ← JOIN[IDELT,J] ← 1;
IF XDMP THEN OUT(3,CRLF&"JOIN"&CVS(IDELT)&CVS(JDELT)&
" AND"&CVS(I)&CVS(E)&CRLF);
END "NOP" ELSE BEGIN "PARA"
LINE[I,E] ← LINE[IDELT,B];
LINE[I,E+1] ← LINE[IDELT,B+1];
JOIN[I,K] ← JOIN[IDELT,(B DIV 2)+1];
IF I<C THEN
BEGIN "PACK"
ARRBLT(LINE[IDELT,1],LINE[C,1],4);
ARRBLT(JOIN[IDELT,1],JOIN[C,1],2);
END "PACK";
C ← C-1;
IF XDMP THEN OUT(3,CRLF&CVS(I)&" PARALLEL"&CVS(IDELT)&CRLF);
END "PARA";
END "JOIN" ELSE BEGIN "BREAK"
IF C+1>CNT*2 THEN USERERR(0,0,"TOO MANY LINES TO BREAK");
C ← C+1;
LINE[C,3] ← LINE[IDELT,3];
LINE[C,4] ← LINE[IDELT,4];
JOIN[C,2] ← JOIN[IDELT,2];
LINE[I,E] ← LINE[IDELT,3] ← LINE[C,1] ← GX;
LINE[I,E+1] ← LINE[IDELT,4] ← LINE[C,2] ← GY;
JOIN[I,K] ← JOIN[IDELT,2] ← JOIN[C,1] ← 1;
IF XDMP THEN OUT(3,CRLF&"BREAK"&CVS(IDELT)&CRLF);
END "BREAK";
IF XDMP THEN DUMPLINE("FIXED",LINE,JOIN,C);
L3: IF E=1 THEN GO TO L2;
L1: END "DANGLE";
⊃ MERGE ALL ENDPOINTS WITHIN COORDMAX OF EACH OTHER AND DELETE EXTRA LINES;
FOR I←1 STEP 1 UNTIL C DO FOR J←1,3 DO
BEGIN "L1"
X1 ← X2 ← LINE[I,J];
Y1 ← Y2 ← LINE[I,J+1];
MERGE(I,E←0,INDEX[1,1],X1,Y1,X2,Y2,LINE[I,1],C);
IF E THEN
BEGIN "L3"
Y1 ← Y2/(E+1);
X1 ← X2/(E+1);
LINE[I,J] ← X1;
LINE[I,J+1] ← Y1;
FOR K←1 STEP 1 UNTIL E DO
BEGIN "L4"
A ← INDEX[K,1];
B ← INDEX[K,2];
LINE[A,B] ← X1;
LINE[A,B+1] ← Y1;
END "L4";
END "L3";
END "L1";
DUP(LINE[1,1],C);
⊃ FIND ALL LINES WHICH MAY BE PART OF A CLOSED OUTLINE;
JMP1: JOIN[1,1] ← 0;
ARRBLT(JOIN[1,2],JOIN[1,1],C*2-1);
IF XDMP THEN DUMPLINE("AFTER MERGE",LINE,JOIN,C);
L5: A ← FALSE;
FNDINT(LINE[1,1],I,JOIN[1,1],A,C);
FOR I←1 STEP 1 UNTIL C DO IF FND∧XDMP THEN OUT(3,CVS(I)&" HANGING"&CRLF);
IF A THEN GO TO L5;
IF XDEB THEN
BEGIN
DPYSETUP;
FADCHG(0,0,AIVECT);
FOR I←1 STEP 1 UNTIL C DO IF ¬HANG(I) THEN
BEGIN
FRDCHG(LINE[I,1],LINE[I,2],RIVECT);
FRDCHG(LINE[I,3],LINE[I,4],RVECT);
END;
DPYBRT(1);
FOR I←1 STEP 1 UNTIL C DO IF HANG(I) THEN
BEGIN
FRDCHG(LINE[I,1],LINE[I,2],RIVECT);
FRDCHG(LINE[I,3],LINE[I,4],RVECT);
END;
DPYOUT(FRAMEX);
INCHWL;
END;
⊃ REMOVE ALL LINES NOT PART OF CLOSED OUTLINE;
IND ← 0;
FOR I←1 STEP 1 UNTIL C DO IF HANG(I) THEN IND←IND+1;
IF IND THEN
BEGIN "REMOVE" REAL ARRAY ARY[1:IND,1:4];
K ← J ← 0;
FOR I ← 1 STEP 1 UNTIL C DO IF HANG(I) THEN
BEGIN "FILL"
D[S+1,1] ← LINE[I,1];
D[S+1,2] ← LINE[I,2];
D[S+2,1] ← LINE[I,3];
D[S+2,2] ← LINE[I,4];
D[S,2] ← 0;
D[S,1] ← -2;
S ← S+3;
ARRBLT(ARY[K←K+1,1],LINE[I,1],4);
END "FILL"
ELSE IF (J←J+1)<I THEN ARRBLT(LINE[J,1],LINE[I,1],4);
C ← J;
EXTLINE ← GLOBAL NEW(ARY);
IF XDMP THEN
BEGIN "D2"
DUMPLINE("OUTLINE",LINE,JOIN,C);
OUT(3,CRLF&"EXTRA LINES"&CRLF);
FOR I←1 STEP 1 UNTIL IND DO
BEGIN
FOR J←1 STEP 1 UNTIL 4 DO OUT(3,CVF(ARY[I,J]));
OUT(3,CRLF);
END;
OUT(3,CRLF);
END "D2";
END "REMOVE";
⊃ GENERATE TABLE OF VERTICIES;
IF ¬C THEN GO TO L4;
STAT_CURV ← TRUE;
BEGIN "DATA"
REAL ARRAY VERT[1:C*2,1:2];
INTEGER ARRAY COUNT[1:C];
LIST ITEMVAR FOO;
INTEGER ITEMVAR FOOX;
LIST REGIONS, VERTICIES;
LABEL JMP2;
BOOLEAN OUTS;
SET DEL;
INTEGER VIND;
VIND ← 0;
GETINT(VERT[1,1],VIND);
FOR I←1 STEP 1 UNTIL C DO FOR J←1,3 DO IF ¬GET(LINE[I,J],LINE[I,J+1]) THEN
BEGIN
VERT[VIND←VIND+1,1]←LINE[I,J];
VERT[VIND,2]←LINE[I,J+1];
END;
REGIONS ← VERTICIES ← PHI;
OUTS ← TRUE;
IF XDMP THEN
BEGIN
OUT(3,"VERTICIES"&CRLF);
FOR I←1 STEP 1 UNTIL VIND DO OUT(3,CVS(I)&CVF(VERT[I,1])&CVF(VERT[I,2])&CRLF);
OUT(3,CRLF);
END;
IND ← 0;
⊃ GENERATE DATA STRUCTURE;
WHILE TRUE DO
BEGIN "GENER"
⊃ FIND LOWEST POINT IN OUTLINE;
Y ← 0;
FOR I←1 STEP 1 UNTIL C DO IF COUNT[I]<2 THEN
FOR K←2,4 DO IF LINE[I,K]>Y THEN BEGIN A←I;B←K;Y←LINE[I,K];END;
IF ¬Y THEN DONE;
X1 ← XX ← X ← LINE[A,B-1];
⊃ FIND REGION BY STARTING WITH LOWEST ENDPOINT
AND FINDING SUCCESSIVE EDGES WITH SMALLEST (LARGEST AFTER OUTSIDE)
ANGLES BETWEEN THEM;
YY ← Y+100.0;
Y1 ← Y;
B ← 0;
VERTICIES ← PHI;
PUT NEW(I←GET(X,Y)) IN VERTICIES AFTER ∞;
IF XDMP THEN BEGIN SETFORMAT(0,0);OUT(3," V"&CVS(I));END;
DO BEGIN "REGION"
A1 ← IF OUTS∨¬B THEN 100.0 ELSE -100.0;
B1 ← ANG(XX-X,YY-Y);
REGINT(C,B,X,Y,I,J,COUNT[1],LINE[1,1]);
WHILE REGGET DO
BEGIN "GET"
F ← IF J=1 THEN 3 ELSE 1;
C1 ← ANG(LINE[I,F]-X,LINE[I,F+1]-Y);
C1 ← IF C1<B1 THEN 4+C1-B1 ELSE C1-B1;
K ← IF OUTS∨¬B THEN C1<A1 ELSE C1>A1;
IF K THEN BEGIN A1←C1; A←I; E←F; END;
END "GET";
IF ABS(A1)=100.0 THEN
BEGIN
OUTSTR("CLOSED CURVE FINDER BLEW UP"&CRLF);
CALL(0,"EXIT");
END;
XX ← X;
YY ← Y;
X ← LINE[A,E];
Y ← LINE[A,E+1];
B ← A;
COUNT[A] ← COUNT[A]+1;
PUT NEW(I←GET(X,Y)) IN VERTICIES AFTER ∞;
IF OUTS THEN
BEGIN
D[S+(IND←IND+1),1]←X;
D[S+IND,2]←Y;
OUTER(A)←TRUE;
END;
IF XDMP THEN OUT(3," V"&CVS(I));
END "REGION" UNTIL ABS(X-X1)<.001∧ABS(Y-Y1)<.001;
OUTS ← FALSE;
PUT NEW(VERTICIES) IN REGIONS AFTER ∞;
IF XDMP THEN OUT(3,CRLF);
END "GENER";
IF IND THEN
BEGIN
D[S,1] ← IND;
S←S+IND+1;
END;
IF TESTX THEN GO TO JMP2;
⊃ OUTPUT DATA STRUCTURE FOR COMPLEX (CURRENTLY ONLY TO DISK FILE SPECIFIED BY USER);
OUTSTR("WE HAVE A FINE, HIGH QUALITY DATA STRUCTURE FOR COMPLEX"&CRLF&
"PLEASE TYPE A FILE NAME FOR IT "&CRLF);
OPEN(5,"DSK",0,2,2,1000,BRK,EOF);
ENTER(5,INCHWL,J);
IF J THEN USERERR(0,0,"ENTER FAILED");
OUT(5,CVS(VIND)&CRLF);
FOR I ← 1 STEP 1 UNTIL VIND DO
BEGIN "DATA2"
SETFORMAT(0,0);
OUT(5," V"&CVS(I));
SETFORMAT(15,8);
OUT(5,CVF(VERT[I,1])&CVF(VERT[I,2])&CRLF);
END "DATA2";
SETFORMAT(0,0);
OUT(5,CRLF&CVS(C)&CRLF);
FOR I ←1 STEP 1 UNTIL C DO
OUT(5," L"&CVS(I)&" V"&CVS(GET(LINE[I,1],LINE[I,2]))&
" V"&CVS(GET(LINE[I,3],LINE[I,4]))&CRLF);
SETFORMAT(0,0);
A ← LENGTH(REGIONS);
OUT(5,CVS(A)&CRLF);
FOR I ← 1 STEP 1 UNTIL A DO
BEGIN "DATA1"
IF I=1 THEN OUT(5,":1 2"&CRLF&" P0 0"&CRLF) ELSE
OUT(5,":"&CVS(I)&" 1"&CRLF);
OUT(5," P"&CVS(I)&" ");
FOO ← REGIONS[I];
VERTICIES ← DATUM(FOO);
B ← LENGTH(VERTICIES);
OUT(5,CVS(B-1));
FOR J ← 1 STEP 1 UNTIL B DO
BEGIN
FOOX ← VERTICIES[J];
OUT(5," V"&CVS(DATUM(FOOX)));
END;
OUT(5,CRLF&CRLF);
END "DATA1";
SETFORMAT(20,8);
OUT(5,(CRLF&CRLF)&(IF CVN(CURCAM) THEN "-1" ELSE "0")&(CRLF&CRLF));
IF CVN(CURCAM) THEN
FOR I←1 STEP 1 UNTIL 10 DO
BEGIN "DATA3"
FOR J ← 1 STEP 1 UNTIL 3 DO OUT(5,CVF(GLOBAL DATUM(CURCAM)[I,J]));
OUT(5,CRLF);
END "DATA3";
OUT(5,CRLF&"END"&CRLF);
RELEASE(5);
OUTSTR("ANALYZE IT IN GOOD HEALTH"&CRLF);
⊃ DELETE LOCAL MODEL;
JMP2: DEL ← CVSET(REGIONS);
A ← LENGTH(REGIONS);
FOR I←A STEP -1 UNTIL 1 DO
BEGIN "DEL"
FOO ← REGIONS[I];
VERTICIES ← DATUM(FOO);
DEL ← DEL∪CVSET(VERTICIES);
END "DEL";
WHILE LENGTH(DEL) DO DELETE(LOP(DEL));
REGIONS ← VERTICIES ← PHI;
END "DATA";
⊃ SET UP DATA STRUCTURE FOR EDGE;
L4: IND ← S;
FOR I←1 STEP 1 UNTIL C DO IF ¬OUTER(I) THEN
BEGIN
D[IND+1,1] ← LINE[I,1];
D[IND+1,2] ← LINE[I,2];
X ← D[IND+2,1] ← LINE[I,3];
Y ← D[IND+2,2] ← LINE[I,4];
OUTER(I) ← TRUE;
A ← 2;
L8: FOR K←1 STEP 1 UNTIL C DO IF ¬OUTER(K)∧X=LINE[K,1]∧Y=LINE[K,2] THEN
BEGIN
A ← A+1;
X ← D[IND+A,1] ← LINE[K,3];
Y ← D[IND+A,2] ← LINE[K,4];
OUTER(K) ← TRUE;
GO TO L8;
END;
D[IND,1] ← -A;
D[IND,2] ← 0;
IND ← IND+A+1;
END;
S ← IND;
D[S,1] ← D[S,2] ← 0;
END;
⊃ PROCESS FITTED OUTLINE;
PROCEDURE PROCESS(SAFEX REAL ARRAY D; INTEGER SCNT,TST);
BEGIN
INTEGER OUTS, INS, OS, IS, IND, I;
SIMPLE PROCEDURE COUNT(SAFEX REAL ARRAY D; REFERENCE INTEGER S, O, I, OS, IS);
BEGIN INTEGER C;
O← I ← OS ← IS ← 0;
IND ← 1;
DO BEGIN
C ← ABS(D[IND,1]);
IF D[IND,1]>0 THEN BEGIN OS←OS+1;O←O+C; END ELSE
BEGIN IS←IS+1; I←I+C; END;
IND ← IND+C+1;
END UNTIL IND≥S;
END;
EXTLINE ← NIL;
COUNT(D,SCNT,OUTS,INS,OS,IS);
FIXUP(D,SCNT,OUTS+INS,TST);
COUNT(D,SCNT,OUTS,INS,OS,IS);
IND ← 1;
IF (XDEB←¬RUN∨DIS_CUR) THEN
BEGIN
DPYSETUP;
FADCHG(0,0,AIVECT);
DO BEGIN "LOOP"
OS ← ABS(D[IND,1]);
IF D[IND,1]>0 THEN
BEGIN "OUTSID"
FRDCHG(D[IND+1,1],D[IND+1,2],RIVECT);
FOR I←2 STEP 1 UNTIL OS DO
FRDCHG(D[IND+I,1],D[IND+I,2],RVECT);
FRDCHG(D[IND+1,1],D[IND+1,2],RVECT);
END "OUTSID" ELSE
FOR I←1 STEP 1 UNTIL OS-1 DO
BEGIN "INSIDE"
FRDCHG(D[IND+I,1],D[IND+I,2],RIVECT);
FRDCHG(D[IND+I+1,1],D[IND+I+1,2],RVECT);
END "INSIDE";
END "LOOP" UNTIL (IND←IND+OS+1)>SCNT;
DPYOUT(FRAMEX);
END;
BEGIN "OUTPUT"
SAFEX REAL ARRAY OT[1:2,0:OUTS], IN[1:4,0:INS];
OS ← IS ← 0;
IND ← 1;
DO BEGIN "OUTLOOP" INTEGER J;
I ← ABS(D[IND,1]);
IF D[IND,1]>0 THEN FOR J←1 STEP 1 UNTIL I DO
BEGIN
OT[1,OS←OS+1] ← D[IND+J,1];
OT[2,OS] ← D[IND+J,2];
END ELSE
FOR J←1 STEP 1 UNTIL I-1 DO
BEGIN
IN[1,IS←IS+1]←D[IND+J,1];
IN[2,IS]←D[IND+J,2];
IN[3,IS]←D[IND+J+1,1];
IN[4,IS]←D[IND+J+1,2];
END;
END "OUTLOOP" UNTIL (IND←IND+I+1)>SCNT;
IF OS THEN BEGIN OT[1,0]←OS;GLOBAL MAKE BOUNDARY⊗NEWBLOB≡GLOBAL NEW(OT);END;
IF IS THEN BEGIN IN[1,0]←IS;GLOBAL MAKE INSIDE_EDGES⊗NEWBLOB≡GLOBAL NEW(IN);END;
END "OUTPUT";
IF EXTLINE≠NIL THEN GLOBAL DELETE (EXTLINE);
END;
⊃ COMPUTE 'ANGLE' FOR CLOSED CURVE ROUTINE;
SIMPLE REAL PROCEDURE ANG(REAL DX, DY);
BEGIN REAL A;
A ← IF DY≥0 THEN DY↑2 ELSE -(DY↑2);
A ← A/(DX↑2+DY↑2);
IF DX<0 THEN A←2-A ELSE IF DY<0 THEN A←4+A;
RETURN(A);
END;
⊃ FIT COMMAND ENTRY
STATUS= -2 CURVE FITTER REJECTED OBJECT
0 OK - CLOSED OUTLINE
1 OK - LINE SEGMENT ;
MESSAGE PROCEDURE CURVE_FIT(REAL ARRAY D);
BEGIN SAFEX REAL ARRAY OUTDAT[1:SMAX,1:2];
INTEGER SCNT, TST;
TST ← CURVE_STATUS;
NEWBLOB ← IF IFGLOBAL(ITVAR_II) THEN ITVAR_II ELSE GLOBAL NEW;
XDEB ← FALSE;
IF (CURVE_STATUS←CUR1(D,OUTDAT,SCNT,SMAX))<0 THEN RETURN;
STAT_CURV ← FALSE;
CURVE_STATUS ← 0;
PROCESS(OUTDAT,SCNT,TST);
IF XDEB THEN DISP(D);
IF ¬STAT_CURV THEN CURVE_STATUS ← 1;
END;
⊃ MAIN PROGRAM;
LABEL L1;
SETBREAK(1,'12,'15,"IN");
PTYDPY ← DISDEV;
PUT_DATA(0,0,"CURVE");
OVERLAY ← TRUE;
DPYCLR;
FRAMEY ← FRAMEX ← -1;
YES_CUR ← TRUE;
I ← -1;
CODE('51300000000,I);
DD_DISP ← ¬(I LAND '400000000000);
L1: IF RUN∧¬DEB_CUR THEN WHILE TRUE DO
BEGIN
I ← GET_ENTRY('170,"EDGE","CURVE","CURVE_FIT");
QUEUE('600,I);
IF DEB_CUR THEN GO TO L1;
END;
WHILE TRUE DO
BEGIN
IF RUN∧¬DEB_CUR THEN GO TO L1;
OUTSTR("DEBUG? ");
IF INCHWL="Y" THEN CURVON ELSE CUROFF;
OUTSTR("MERGE LINES ?");
CURVE_STATUS ← INCHWL≠"Y";
SETFORMAT(0,0);
OPEN(1,"DSK",0,2,2,1000,BRK,EOF);
OUTSTR("SET # =");
I ← CVD(INCHWL);
LOOKUP(1,"DATA"&CVS(I),J);
IF J THEN USERERR(0,0,"LOOKUP FAILED");
I ← INTSCAN(INP←INPUT(1,1),BRK);
BEGIN SAFEX REAL ARRAY DAT[1:I,1:2];
FOR J←1 STEP 1 UNTIL I DO
BEGIN
INP ← INPUT(1,1);
DAT[J,1]←REALSCAN(INP,BRK);
DAT[J,2]←REALSCAN(INP,BRK);
END;
DISSIZ ← I+20;
DISP(DAT);
CURVE_FIT(DAT);
END;
RELEASE(1);
RELEASE(3);
END;
END;